home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Delphi Developer's Kit 1996
/
Delphi Developer's Kit 1996.iso
/
power
/
texec
/
dexec.pas
< prev
next >
Wrap
Pascal/Delphi Source File
|
1995-12-22
|
3KB
|
141 lines
unit dexec;
interface
uses
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, Forms;
type
Tshow=(Normal, Minimized, Maximized);
TExec = class(TComponent)
private
Fprogname: String;
Fprogparams: String;
Fshow: Tshow;
Fwait: boolean;
Ftimeout: word;
Freturncode:integer;
Freasoncode:integer;
Finstance:integer;
Fmessage:string;
public
Constructor Create(AOwner:TComponent); override;
Destructor Destroy; override;
Procedure Exec;
published
property ProgName:String Read Fprogname Write FProgname;
property ProgParams:String Read Fprogparams Write FProgparams;
property Show:Tshow Read Fshow Write Fshow;
property Wait:Boolean Read Fwait Write Fwait;
property Timeout:word Read Ftimeout Write Ftimeout;
property Returncode:Integer Read Freturncode;
property Reasoncode:Integer Read Freasoncode;
property Instance:Integer Read FInstance;
property Message:string Read Fmessage;
end;
procedure Register;
implementation
Destructor TExec.Destroy;
Begin
inherited Destroy;
End;
Constructor TExec.Create(AOwner:TComponent);
Begin
inherited Create(AOwner);
Fprogname:='';
Fprogparams:='';
Fshow:= Normal;
Fwait:= False;
Ftimeout:= 0;
Freturncode:=0;
Fmessage:='';
Freasoncode:=0;
Finstance:=0;
End;
Procedure Texec.Exec;
var
szCline: pchar;
i:integer;
sw:word;
stime,ctime:Tdatetime;
hrs,mins,secs,msecs: word;
begin
try
Fmessage:='';
Freturncode:=0;
Freasoncode:=0;
Finstance:=0;
stime:=sysutils.time;
sw:=SW_SHOWNORMAL;
case ord(Fshow)of
1: sw:=SW_SHOWMINNOACTIVE;
2: sw:=SW_SHOWMAXIMIZED;
end;
szcline:=allocmem(length(Fprogname)+length(Fprogparams)+1);
strpcopy(szcline,Fprogname+' '+Fprogparams);
i:=winexec(szcline,sw);
if i < 32 then
begin
Freturncode:=1;
Freasoncode:=i;
Fmessage:='File Not Found';
case Freasoncode of
0: Fmessage:='Out Of Memory';
3: Fmessage:='Path Not Found';
5: Fmessage:='Sharing Violation';
6: Fmessage:='Library/Segment Error';
8: Fmessage:='Out of Memory';
10: Fmessage:='Incorrect Windows Version';
11: Fmessage:='Invalid File';
12: Fmessage:='Incorrect DOS Version';
13: Fmessage:='Incorrect DOS Version';
14: Fmessage:='No Association for File Type';
15: Fmessage:='Incorrect Windows Version';
16: Fmessage:='Program Already Running';
19: Fmessage:='File is Compressed';
20: Fmessage:='Invalid DLL';
21: Fmessage:='Program Requires 32-bit Extensions';
end;
end
else
begin
Finstance:=i;
if Fwait then
begin
while getmoduleusage(i) > 0 do
begin
application.processmessages;
decodetime (sysutils.time-stime,hrs,mins,secs,msecs);
hrs:=hrs*60+mins;
hrs:=hrs*60+secs;
if (Ftimeout > 0) and (Ftimeout < hrs) then
begin
Freturncode:=2;
break;
end;
end;
end;
end;
finally
freemem(szcline,length(Fprogname)+length(Fprogparams)+1);
end;
End;
procedure Register;
begin
RegisterComponents('System', [TExec]);
end;
end.